CNV

Code

cat("## ",params$sample,params$chr,params$start,params$end,"\n")

B00GM8Z 4 28752825 35734550

Code

ZeSTART<-as.numeric(params$start)-(as.numeric(params$end)-as.numeric(params$start))*0.33
ZeEND<-as.numeric(params$end)+(as.numeric(params$end)-as.numeric(params$start))*0.33


levels(Exons$seqid)<-gsub("chr","",levels(Exons$seqid))
LocalExons<-Exons[Exons$seqid==params$chr & (Exons$start>ZeSTART | Exons$end>ZeSTART) & (Exons$end<ZeEND | Exons$start<ZeEND),]
LocalTranscript<-LocalExons[LocalExons$type=="transcript",]
LocalTranscript.GR<-makeGRangesFromDataFrame(LocalTranscript,keep.extra.columns = TRUE)

seqlevels(LocalTranscript.GR)<-c(seqlevels(LocalTranscript.GR),paste(23:999))

SELF.OVLP<-data.frame(findOverlaps(LocalTranscript.GR,LocalTranscript.GR,ignore.strand=TRUE))
SELF.OVLP<-SELF.OVLP[SELF.OVLP$queryHits!=SELF.OVLP$subjectHits,]

while(dim(SELF.OVLP)[1]>0){
  ToUP<-unique(as.numeric(as_data_frame(as.undirected(graph_from_data_frame(SELF.OVLP)))$to))
  runValue(seqnames(LocalTranscript.GR)[ToUP])<-as.numeric(runValue(seqnames(LocalTranscript.GR)[ToUP]))+1
  SELF.OVLP<-data.frame(findOverlaps(LocalTranscript.GR,LocalTranscript.GR,ignore.strand=TRUE))
SELF.OVLP<-SELF.OVLP[SELF.OVLP$queryHits!=SELF.OVLP$subjectHits,]

}

LocalTranscript.FakeCHR.DF<-data.frame(LocalTranscript.GR)[,c("seqnames","transcript_id","start","end")]
colnames(LocalTranscript.FakeCHR.DF)<-c("Height","transcript_id","Tx_start","Tx_end")
LocalTranscript.FakeCHR.DF$Height<-as.numeric(LocalTranscript.FakeCHR.DF$Height)*2
MaxHEIGHT<-max(as.numeric(as.vector(LocalTranscript.FakeCHR.DF$Height)))


LocalExons<-merge(LocalExons,LocalTranscript.FakeCHR.DF,sort=FALSE,all.x=TRUE)
LocalExons<-LocalExons[LocalExons$type=="exon",]

# LocalBINS.GR<-disjoin(LocalTranscript.GR)
# LocalBINS.PAIRS<-findOverlaps(LocalBINS.GR,LocalTranscript.GR,ignore.strand=TRUE)  
# LocalBINS.PAIRS.DF<-data.frame(LocalBINS.PAIRS)
# HEIGHTS<-data.frame(height=table(from(LocalBINS.PAIRS)))
# colnames(HEIGHTS)<-c("Bin","Height")
# LocalBINS.PAIRS.DF<-merge(
#   LocalBINS.PAIRS.DF,
#   HEIGHTS,
#   by.x="queryHits",
#   by.y="Bin")
# LocalBINS.PAIRS.DF.UNIQUE<-LocalBINS.PAIRS.DF[!duplicated(LocalBINS.PAIRS.DF$subjectHits),]
# LocalTranscript.GR$HEIGHT<-0
# LocalTranscript.GR$HEIGHT[LocalBINS.PAIRS.DF.UNIQUE$subjectHits]<-LocalBINS.PAIRS.DF.UNIQUE$Height

LocalExons$MIDDLE<-LocalExons$start+(LocalExons$end-LocalExons$start)/2

LocalExons.GR<-makeGRangesFromDataFrame(LocalExons,keep.extra.columns = TRUE)

LocalSample<-data[`Sample ID`==params$sample]
#LocalSample<-data[`Sample ID`=="B00GLZI"]
LocalSample<-LocalSample[Position>ZeSTART & Position<ZeEND]


Controls<-unlist(Infos[Statut==1][,c("Barcode")])

LocalBG<-data[`Sample ID` %in% Controls]
LocalBG<-LocalBG[Position>ZeSTART & Position<ZeEND]
LocalBGAvg<-LocalBG[,.(AVG_LRR=mean(`Log R Ratio`,na.rm=TRUE)),by=Position]
LocalSample<-merge(LocalSample,LocalBGAvg)
LocalTranscripts<-unique(LocalExons[,c("transcript_name",
                                "Tx_start",
                                "Tx_end",
                                "Height")])


#Inserer les genes
#Inserer violon du background

Code

vline <- function(x = 0, color = "red") {
  list(
    type = "line", 
    y0 = 0, 
    y1 = 1, 
    yref = "paper",
    x0 = x, 
    x1 = x, 
    line = list(color = color)
  )
}



Rectangles <- list()

for (i in seq_along(LocalExons.GR)) {
  Rectangle<-list()
  Rectangle[["x0"]] <- start(LocalExons.GR)[i]

  Rectangle[["x1"]] <- end(LocalExons.GR)[i]

  Rectangle[["y0"]] <- as.numeric(LocalExons.GR$Height[i])
  
  Rectangle[["y1"]] <- as.numeric(LocalExons.GR$Height[i])+0.75
  
  Rectangle[["type"]] <- "rect"
  
  Rectangle[["fillcolor"]] <- "purple"
  
  Rectangle[["line"]] = list(color = "blue")
  
  Rectangle[["opacity"]] = 0.3
  
  Rectangle[["xref"]] = "x"
  
  Rectangle[["yref"]] = "y"
  Rectangles <- c(Rectangles, list(Rectangle))
}

transcripts <- list()

for (i in 1:dim(LocalTranscripts)[1]) {
  line<-list()
  line[["type"]]="line"

  line[["line"]] = list(color = "#0000FF12")

  line[["xref"]] = "x"

  line[["yref"]] = "y"

  line[["x0"]] <- LocalTranscripts$Tx_start[i]

  line[["x1"]] <- LocalTranscripts$Tx_end[i]

  line[c("y0", "y1")] <- LocalTranscripts$Height[i]+0.25

  transcripts <- c(transcripts, list(line))

}


Rectangles <- c(transcripts,Rectangles, list(vline(as.numeric(params$start))),list(vline(as.numeric(params$end))))





#fig1<-plot_ly(data=LocalBG,y = ~`Log R Ratio`,x=~Position, type =
#                "box",marker = list(width=50))
fig1<-plot_ly(data=LocalSample,y = ~AVG_LRR,x=~Position, type =
                "scatter",marker = list(width=50),
              text=~`SNP Name`,
    hovertemplate = paste('SNP name: %{text}<br>Control average Log R Ratio: %{y}<extra></extra>'))



fig1<-add_trace(fig1,data=LocalSample,
    type = 'scatter',mode = 'markers',
    x = ~Position,
    y = ~`Log R Ratio`,
    text=~`SNP Name`,
    hovertemplate = paste('SNP name: %{text}<br>Log R Ratio: %{y}<extra></extra>'))

fig1 <- layout(fig1,shapes=c(list(vline(as.numeric(params$start))),list(vline(as.numeric(params$end)))),yaxis =list(range=c(-2,2),constrain="domain",fixedrange=TRUE))

fig2<-plot_ly()

fig2<-layout(fig2,
               shapes=Rectangles,
             xaxis =list(range=c(as.numeric(params$start)-(as.numeric(params$end)-as.numeric(params$start))*0.33,as.numeric(params$end)+(as.numeric(params$end)-as.numeric(params$start))*0.33),constrain="domain",showgrid = FALSE),
             yaxis =list(range=c(2,30),constrain="domain",fixedrange=TRUE,
               showgrid = FALSE))


 fig2<-add_trace(fig2,
                  type="scatter",
                  mode="markers",
                  y = as.numeric(LocalExons.GR$Height)+0.5,
                 x = as.numeric(LocalExons.GR$MIDDLE),
                 text = paste0(
                   LocalExons.GR$gene_name,"\n",
                   LocalExons.GR$transcript_id,"\n",
                   LocalExons.GR$exon_id),
    hovertemplate = paste('%{text}<extra></extra>'),
    marker = list(

      color = '00FFFFFF',

      size = 0.1,

      line = list(

        color = '00FFFFFF',

        width = 0.1

      )))

 figB <- plot_ly(data = LocalSample, x = ~Position, y = ~`B Allele Freq`,text=~`SNP Name`,hovertemplate = paste('SNP: %{text}<br>BAF: %{y}<extra></extra>'))
figB<-layout(
  figB,
  xaxis =list(
    range=c(as.numeric(params$start)-(as.numeric(params$end)-as.numeric(params$start))*0.33, as.numeric(params$end)+(as.numeric(params$end)-as.numeric(params$start))*0.33),
    constrain="domain"),
  yaxis =list(range=c(-0.1,1.1),
              constrain="domain",fixedrange=TRUE),
  shapes=list(vline(as.numeric(params$start)),vline(as.numeric(params$end))))
    
fig <- subplot(fig1, fig2,figB,nrows = 3,shareX = TRUE)
fig<-layout(fig,
            hovermode="x unified",
            showlegend = FALSE,
            xaxis = list(hoverformat = 'Position: %{x,d}<extra></extra>'),
            hoverlabel='Position: %{x,d}<extra></extra>')
fig

Figure du haut

Log R Ratio intensité de fluorescence

en bleu l’intensitéde fluorescence moyenne sur les controles, box plot pour représenter l’ensemble des controles

en orange l’intensité de fluorescence sur l’échantillon A008DSW-F5

Le graphe du milieu représente les différentes isoformes présentes dans la fenetres, je n’ai pas réussi a trouvé dajustement automatique des ordonnées en fonction du nombre de transcripts présents dans la fenetres

En bas la B allele frequency